Collection of Tools & Utilities/Collection of Tools and Utilities.iso/turbovis/oodb.zip/OODB.PAS

Pascal/Delphi Source File | 1992-07-13 | 26KB | 747 lines

unit OODB;

interface

   uses Objects;

   const
      PIDLimit: Word = $7FFF;
      Delta = 4;
      Hallmark = 9999;
      IndexPointerLocation = 4;
      StorageStart = 8;

   type

      { Record type for object registration }

      IndRec =
         record
            ID        : Word;
            StartPos,
            Size      : Longint;
            Base      : Integer
         end;
      PIndRec = ^IndRec;

      { Stream for object size evaluation }

      TNullStream =
         object (TStream)
            SizeCounter : Longint;
            constructor Init;
            procedure   ResetCounter;                   virtual;
            procedure   Write (var Buf; Count: Word);   virtual;
            function    SizeInStream: Longint;          virtual;
         end;
      PNullStream = ^TNullStream;

      { Stream - database main storage }

      DBStream = TStream;
      PDBStream = ^DBStream;

      { Collection for indexes }

      TIndexCollection =
         object (TCollection)
            procedure FreeItem (Item: Pointer);                 virtual;
            function  GetItem (var S: TStream): Pointer;        virtual;
            procedure PutItem (var S: TStream; Item: Pointer);  virtual;
         end;
      PIndexCollection = ^TIndexCollection;

      { --- TBASE - the main class --- }

      TBase =
         object (TObject)

            BaseStream : PDBStream;         { Main storage pointer }
            DBIndex,                        { Database index }
            HolesIndex : PIndexCollection;  { Holes index }
            PIDCurrent : Word;              { Unique identifier }
            NS         : PNullStream;       { For object size evaluation }
            DoneFlag   : Boolean;           { True if OODB is being disposed }

            function  BytesInStream (P: PObject): Longint ;
                               virtual;
            procedure IndexSort (Cat: PIndexCollection; StOrd: Boolean);
                               virtual;
            function  IndexFound (Cat: PIndexCollection;
                                  LookFor: Longint;
                                  var Pos: Integer;
                                  PIDSorted: Boolean): Boolean;
                               virtual;
            function  HoleFound (S: Longint; var Pos: Longint): Boolean;
                               virtual;

            procedure   Abort;                          virtual;
            procedure   Commit;                         virtual;
            constructor Init (AStream: PDBStream);
            destructor  Done;                           virtual;
            function    Create: Word;                   virtual;
            procedure   Put (PID: Word; P: PObject);    virtual;
            function    Get (PID: Word): PObject;       virtual;
            procedure   Destroy (PID: Word);            virtual;

            function    ObjSize (PID: Word): Longint;   virtual;
            function    Count: Integer;                 virtual;

            procedure   IdlePack;                       virtual;

         end; { -- TBase -- }
      PBase = ^TBase;

implementation

   { -- Implementation of TNullStream -- }

   constructor TNullStream.Init;
      begin
         TStream.Init;
         ResetCounter
      end;

   procedure TNullStream.ResetCounter;
      begin
         SizeCounter := 0
      end;

   procedure TNullStream.Write (var Buf; Count: Word);
      { Overrides TStream.Write method }
      begin
         SizeCounter := SizeCounter + Count
      end;

   function TNullStream.SizeInStream: Longint;
      begin
         SizeInStream := SizeCounter
      end;

   { -- End of TNullStream implementation -- }

   { -- Implementation of TIndexCollection -- }

   procedure TIndexCollection.FreeItem (Item: Pointer);

      begin
         Dispose (Item)
      end;  { FreeItem }

   function TIndexCollection.GetItem (var S: TStream): Pointer;

      var Item : PIndRec;

      begin
         New (Item);
         with S do
              with Item^ do
                   begin
                      Read (ID, SizeOf(ID));
                      Read (StartPos, SizeOf(StartPos));
                      Read (Size, SizeOf(Size));
                      Read (Base, SizeOf(Base))
                   end;
         GetItem := Item
      end;  { GetItem }

   procedure TIndexCollection.PutItem (var S: TStream; Item: Pointer);

      begin
         with S do
              with IndRec(Item^) do
                   begin
                      Write (ID, SizeOf(ID));
                      Write (StartPos, SizeOf(StartPos));
                      Write (Size, SizeOf(Size));
                      Write (Base, SizeOf(Base))
                   end
      end;  { PutItem }

   { -- End of TIndexCollection implementation -- }

   { -- TBASE IMPLEMENTATION -- }

   { ----- BytesInStream ------------------------------------------ }

   function TBase.BytesInStream (P: PObject): Longint ;

   { Determines the number of bytes required
     to put an object into the stream }

      begin
         with NS^ do
              begin
                 ResetCounter;
                 Put (P);
                 BytesInStream := SizeInStream
              end
      end;

   { ----- IndexSort ---------------------------------------------- }

   procedure TBase.IndexSort (Cat: PIndexCollection; StOrd: Boolean);

   { Bubble-sorts any index (DBIndex or HolesIndex) according either to
     StartPos'es in a stream (StOrd = True) or to PID's (StOrd = False) }

      var
         i, j, k : Integer;
         Min     : Longint;
         Aux     : PIndRec;

      begin

         with Cat^ do

              for i := 0 to Count-2 do

                  begin
                     if StOrd
                        then begin
                                Min := IndRec(At(i)^).StartPos; k := i;
                                for j := i+1 to Count-1 do
                                    if IndRec(At(j)^).StartPos < Min
                                        then begin
                                                k := j;
                                                Min := IndRec(At(k)^).StartPos
                                             end
                             end
                        else begin
                                Min := IndRec(At(i)^).ID; k := i;
                                for j := i+1 to Count-1 do
                                    if IndRec(At(j)^).ID < Min
                                       then begin
                                               k := j;
                                               Min := IndRec(At(k)^).ID
                                            end
                             end;
                     Aux := At (i);
                     AtPut (i,At(k)); AtPut (k,Aux)    { Bubble is up }
                  end  { for }

      end; { IndexSort }

   { ----- IndexFound --------------------------------------------- }

   function TBase.IndexFound
                  (Cat: PIndexCollection; LookFor: Longint;
                   var Pos: Integer; PIDSorted: Boolean)    : Boolean;

   { Looks for LookFor in Cat^ index (binary search) and returns True
     if hits it. Position for LookFor (Pos) is located by all means }

      var
         m, j  : Integer;
         Value : Longint;     { Value that is found }

      begin

         IndexFound := False;
         with Cat^ do
              begin
                 Pos := 0; j := Count-1;
                 if j < Pos
                    then Exit;
                 while j > Pos do
                       begin
                          m := ( Pos + j ) div 2;
                          if ( PIDSorted and
                               (IndRec(At(m)^).ID >= LookFor) )
                             or
                             ( not PIDSorted and
                               (IndRec(At(m)^).StartPos >= LookFor) )